home *** CD-ROM | disk | FTP | other *** search
- { Purpose: Program to illustrate the use of Tickable menu items.
-
- Compile notes: I have all my standard text for message boxes and dialogs
- in a resource file that is initialised before object MyApp
- is initialised. To compile this program with standard TV
- units, remove the reference to the Messages unit in the
- 'uses' clause and remove the procedure calls to InitMessages
- and DoneMessages in the program procedure.
-
- Use freely if you find it useful.
-
- (C) Bill Seddon 1992 CompuServe 100111,557 }
-
- Program MenuTest;
-
- uses App, Drivers, Menus, MenuTick, Messages, Objects, Views;
-
- const
- cmMenuItem1 = 100;
- cmMenuItem2 = 101;
- cmMenuItem3 = 102;
-
- type
- PMyApp = ^TMyApp;
- TMyApp = object( TApplication )
- Procedure HandleEvent( var Event : TEvent ); virtual;
- Procedure InitMenuBar; virtual;
- end;
-
- {== TMyApp methods ==========================================================}
-
- { Here HandleEvent is used to change the mark on the selected MenuItem (see
- below). In reality, this will be done in some more meaningful way in the
- HandleEvent (or method called by HandleEvent) of an object that responds to
- particular a particulat command. Here it just toggles the check mark }
-
- Procedure TMyApp.HandleEvent( var Event : TEvent );
- begin
- if ( Event.What = evCommand ) then
- if ( Event.Command in [cmMenuItem1..cmMenuItem3] ) then
- begin
- if MenuItemIsChecked( MenuBar^.Menu, Event.Command ) then
- ClearMenuItem( MenuBar^.Menu, Event.Command ) else
- CheckMenuItem( MenuBar^.Menu, Event.Command );
- end;
-
- TApplication.HandleEvent( Event );
- end;
-
- { This method builds a menu structure in the same way as usual. The change
- here is that instead of calling the NewItem function, the MenuTick function
- NewCheckItem is used. If the Checked parameter is true then the item will
- appear in the menu bar already checked. }
-
- Procedure TMyApp.InitMenuBar;
- var
- R : TRect;
- begin
- GetExtent( R );
- R.B.Y := R.A.Y+1;
- MenuBar := New( PMenuBar, Init( R, NewMenu(
- NewSubMenu( '~T~est', hcNoContext, NewMenu(
- NewCheckItem( 'Menu Item ~1~', 'Alt-A', kbAltA,
- cmMenuItem1, hcNoContext, False,
- NewCheckItem( 'Menu Item ~2~', 'Alt-B', kbAltB,
- cmMenuItem2, hcNoContext, False,
- NewCheckItem( 'Menu Item ~3~', 'Alt-C', kbAltC,
- cmMenuItem3, hcNoContext, True,
- nil ) ) ) ),
- NewItem( 'E~x~it', '', kbNoKey, cmQuit, hcNoContext, nil ) ) ) ) );
- end;
-
- var
- MyApp : TMyApp;
-
- begin
- InitMessages;
- MyApp.Init;
- MyApp.Run;
- MyApp.Done;
- DoneMessages;
- end.